home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / note20.zip / NOTE.PAS < prev   
Pascal/Delphi Source File  |  1990-03-10  |  43KB  |  1,385 lines
  1. {$B+}    {Boolean complete evaluation on} 
  2. {$I+}    {I/O checking on} 
  3. {$N-}    {No numeric coprocessor} 
  4. {$R-}    {Range checking off} 
  5. {$S+}    {Stack checking on} 
  6. {$V-}    {Var String checking off} 
  7.  
  8. Program Note; 
  9.  
  10. {************************************************************************} 
  11. {*        Copyright (c) Steve Edwards, TurboWorks Software, 1988        *} 
  12. {* Released to the public domain for personal , non-commercial use only *} 
  13. {************************************************************************} 
  14.  
  15. {*********************** --- IBM PC SPECIFIC --- ************************} 
  16. {*  Written  9/12/88, Steve Edwards, 501-575-6814                       *} 
  17. {*  Updated 10/13/88  for faster video writes.                          *} 
  18. {*                                                                      *} 
  19. {*  NOTE is a full screen editor which is designed to function as a     *} 
  20. {*  programmer's editor for MS-DOS.   Most of the keyboard commands     *} 
  21. {*  are similar to WordStar , with some special extensions for this     *} 
  22. {*  editor.  Requires Turbo Pascal Ver 4.0 to compile as it stands.     *} 
  23. {*                                                                      *} 
  24. {*  FEATURES:                                                           *} 
  25. {*      Filenames may include drive and path                            *} 
  26. {*      size of files limited to available memory                       *} 
  27. {*      full cursory key usage                                          *} 
  28. {*      full forward and reverse scrolling at high speed                *} 
  29. {*      horizontal scrolling                                            *} 
  30. {*      on-line help ( press F1 for help )                              *} 
  31. {*      search for strings ( forward mode only )                        *} 
  32. {*      search & replace strings ( forward mode only )                  *} 
  33. {*      block commands -- copy, move, delete, write                     *} 
  34. {*                                                                      *} 
  35. {************************************************************************} 
  36.  
  37. Uses Crt, 
  38.      Dos, 
  39.      Printer; 
  40.  
  41. Const 
  42.    MaxWidth      = 128; 
  43.    RtMrg         : Integer = 76; 
  44.    LeftM         : Integer = 1; 
  45.    Wrap          : Boolean = True; 
  46.    InSrt         : Boolean = True; 
  47.    GoodColorCard : Boolean = True;     {set false for IBM CGA} 
  48.  
  49. Type 
  50.    Line       = String[MaxWidth]; 
  51.    LPtr       = ^LineRec; 
  52.    LineRec    = Record 
  53.                   Last : LPtr; 
  54.                   Data : Line; 
  55.                   Next : LPtr; 
  56.                 End; 
  57.    ScreenLine = String[80]; 
  58.    String80   = String[80]; 
  59.    Word       = String[24]; 
  60.  
  61. Var 
  62.    LWord                    : ScreenLine;     { left margin spacer } 
  63.    Find ,Repl , 
  64.    InPut,OutPut             : Word; 
  65.    Fore , Back, Attr        : Byte;           { text colors for Write} 
  66.    BaseOfScreen,Mode        : LongInt;        { used by FASTWRITE } 
  67.    WaitforRetrace           : Boolean;        {  "   "      "     } 
  68.    VidStatPort, VidModePort : LongInt;        {  "   "      "     } 
  69.    ModePortData             : Byte Absolute $40 : $65; {          } 
  70.    SearchString, 
  71.    Replacement              : ScreenLine; 
  72.    TextLine ,BlankLine      : ScreenLine; 
  73.    FileFound, 
  74.    Finished ,Changed        : Boolean; 
  75.    TabSet                   : Array [1..MaxWidth] Of Boolean; 
  76.    TextFile                 : Text; 
  77.    WorkFile                 : Text; 
  78.    Ln,LastLn,NextLn, 
  79.    FirstLn,EndLn            : LPtr; 
  80.    MaxLines                 : Integer ; 
  81.    IBeg    , IEnd           : Integer ; 
  82.    BlockBeg, BlockEnd       : LPtr; 
  83.    I , J,                     {cursor position: i = line, j = column} 
  84.    Len,                       {length of current line} 
  85.    NLines,                    {length of file} 
  86.    NBl,                       {number of buffer lines} 
  87.    Top,                       {first line on screen} 
  88.    Offset, K, N             : Integer; 
  89.    Choice, Ch               : Char; 
  90.  
  91. (*-------------------------------------------------------------------*) 
  92.  
  93. Function YN: Boolean; 
  94. Begin 
  95.   Repeat 
  96.     Ch := ReadKey 
  97.   Until Ch In['y','Y','n','N']; 
  98.   If UpCase(Ch) = 'Y' Then 
  99.     YN := True 
  100.   Else YN := False; 
  101. End; 
  102.  
  103. Procedure Beep; 
  104. Begin 
  105.   Sound(800); 
  106.   Delay(400); 
  107.   NoSound; 
  108.   Delay(1000); 
  109. End; 
  110.  
  111. Procedure Capitalize(var fname:word); 
  112. Begin 
  113.   For J := 1 To Length(FName) Do 
  114.     FName[J] := UpCase(FName[J]); 
  115. End; 
  116.  
  117. Procedure ReadFile; 
  118. Var  OvFlw     : Boolean; 
  119.      InputLine : String[255]; 
  120. Begin 
  121.   If ParamStr(1) = '' Then 
  122.     Begin 
  123.       Write('File to edit: '); 
  124.       ReadLn(Input); 
  125.     End 
  126.   Else 
  127.     InPut := ParamStr(1); 
  128.   Capitalize(Input); 
  129.   New(Ln); 
  130.   Ln^.Data := ''; 
  131.   FirstLn  := Ln; 
  132.   EndLn    := Ln; 
  133.   Assign(WorkFile,Input); 
  134.   {$I-} ReSet(WorkFile); {I+} 
  135.   If IoResult = 0 Then 
  136.     Begin 
  137.       OvFlw := False; 
  138.       MaxLines := MemAvail Div 12; 
  139.       If MaxLines < 0 Then 
  140.         MaxLines := 2730; 
  141.       NLines := 0; 
  142.       Write(' Reading file '); 
  143.       While Not (Eof(WorkFile) Or OvFlw) Do 
  144.         Begin 
  145.           ReadLn(WorkFile,InputLine); 
  146.           If Length(InputLine) > MaxWidth Then 
  147.             Begin 
  148.               WriteLn('File is too fat for this editor'); 
  149.               OvFlw := True; Delay(1000); 
  150.             End 
  151.           Else 
  152.             Begin 
  153.               Ln^.Data := InputLine; 
  154.               LastLn   := Ln; 
  155.               New(Ln); 
  156.               Ln^.data     := ''; 
  157.               Ln^.last     := LastLn; 
  158.               LastLn^.Next := Ln; 
  159.               NLines       := NLines + 1; 
  160.               If NLines > MaxLines Then 
  161.                 Begin 
  162.                   WriteLn('File is too long. Not enough memory'); 
  163.                   OvFlw := True; Delay(1000); 
  164.                 End; 
  165.             End; 
  166.         End;       {not EOF} 
  167.      EndLn := Ln; 
  168.      If Not OvFlw Then 
  169.        FileFound := True; 
  170.     End   {IOresult = 0} 
  171.   Else 
  172.     Begin 
  173.       Write('Can''t find this file. Is this a new file?'); 
  174.       If YN Then 
  175.         Begin 
  176.           FileFound := True; 
  177.           NLines := 1; 
  178.           New(Ln); 
  179.           Ln^.Data      := ''; 
  180.           FirstLn^.Next := Ln; 
  181.           Ln^.Last      := FirstLn; 
  182.           EndLn         := Ln; 
  183.         End 
  184.       Else 
  185.         FileFound := False; 
  186.     End; 
  187.   Close(WorkFile); 
  188. End; 
  189.  
  190. Procedure WriteFile;     { save changes to file } 
  191. Begin 
  192.   GotoXY(1,1); For J := 1 To 45 Do Write(' '); 
  193.   GotoXY(1,1); Write('Text was changed. Save? '); 
  194.   If YN Then 
  195.     Begin 
  196.       Write('as: '); ReadLn(OutPut); 
  197.       If OutPut = '' Then 
  198.         OutPut := Input; 
  199.       Capitalize(OutPut); 
  200.       GotoXY(40,1); WriteLn('    Writing to disk as ',OutPut); 
  201.       Assign(WorkFile,OutPut); 
  202.       ReWrite(WorkFile); 
  203.       Ln := EndLn^.Next; 
  204.       Repeat 
  205.         WriteLn(WorkFile,Ln^.Data); 
  206.         Ln := Ln^.Next 
  207.       Until Ln = EndLn; 
  208.       Close(WorkFile); 
  209.    End; 
  210. End; 
  211.  
  212. {------------------------- FastWrite Routines -------------------------} 
  213.  
  214. Function Attribute(Foreground, Background : Byte) : Byte; 
  215.   {-Translates foreground and background colors into video attributes. 
  216.     "And 127" masks out the blink bit. Add 128 to the result to set it.} 
  217. Begin 
  218.    Attribute := ((Background Shl 4) + Foreground) And 127; 
  219. End; 
  220.  
  221. Function EgaInstalled : Boolean; 
  222.   {-Test for presence of the EGA. I have little idea how this works, but 
  223.     it does.} 
  224. Begin 
  225. Inline( 
  226.   $B8/$00/$12      {      MOV AX,$1200} 
  227.   /$BB/$10/$00     {      MOV BX,$10} 
  228.   /$B9/$FF/$FF     {      MOV CX,$FFFF} 
  229.   /$CD/$10         {      INT $10} 
  230.   /$31/$C0         {      XOR AX,AX} 
  231.   /$81/$F9/$FF/$FF {      CMP CX,$FFFF} 
  232.   /$74/$01         {      JE DONE} 
  233.   /$40             {      INC AX} 
  234.   /$88/$46/$04     {DONE: MOV [BP+$04],AL} 
  235. ); 
  236. End; 
  237.  
  238. Procedure GetVideoMode; 
  239.   {-Video mode of 7 indicates mono display; all other modes are for color 
  240.     displays. This routine MUST be called before any of the screen writing 
  241.     routines are used!} 
  242. Var 
  243.   Mode : Integer; 
  244.   Vid  : Integer Absolute $40 : $63; 
  245. Begin 
  246.      Inline( 
  247.        $B4/$0F        {MOV AH,$F} 
  248.        /$CD/$10       {INT $10} 
  249.        /$30/$E4       {XOR AH,AH} 
  250.        /$89/$46/<Mode {MOV [BP+<Mode],AX} 
  251.      ); 
  252.      If Mode = 6 Then Mode := 7; 
  253.      If Mode = 7 Then BaseOfScreen := $B000  { Mono } 
  254.                  Else BaseOfScreen := $B800; { Color } 
  255.      VidStatPort    := Vid + 6;   {video status port for either card} 
  256.      VidModePort    := Vid + 4;   {video mode port for either card} 
  257.      WaitForRetrace := (BaseOfScreen = $B800) And Not EgaInstalled; 
  258.      { *VERY IMPORTANT*  WaitForRetrace MUST be false if BaseOfScreen = $B000. } 
  259. End; 
  260.  
  261. Procedure VideoOff; 
  262. {-avoid snow writing full screen to c/g card} 
  263. Begin 
  264.   {clear video enable bit} 
  265.   Port[VidModePort] := ModePortData And 247; 
  266. End; 
  267.  
  268. Procedure VideoOn; 
  269. {-reenable video} 
  270. Begin 
  271.   {set video enable bit} 
  272.   Port[VidModePort] := ModePortData Or 8; 
  273. End; 
  274.  
  275. Procedure FastWrite( St : String80; Row, Col, Attr : Byte ); 
  276.   {-Write St directly to video memory, without snow.} 
  277. Begin 
  278. Inline( 
  279.   $1E                    {         PUSH DS                  ;Save DS} 
  280.   /$31/$C0               {         XOR AX,AX                ;AX = 0} 
  281.   /$88/$C1               {         MOV CL,AL                ;CL = 0} 
  282.   /$8A/$AE/>Row          {         MOV CH,[BP+>Row]         ;CX = Row * 256} 
  283.   /$FE/$CD               {         DEC CH                   ;Row to 0..24 range} 
  284.   /$D1/$E9               {         SHR CX,1                 ;CX = Row * 128} 
  285.   /$89/$CF               {         MOV DI,CX                ;Store in DI} 
  286.   /$D1/$EF               {         SHR DI,1                 ;DI = Row * 64} 
  287.   /$D1/$EF               {         SHR DI,1                 ;DI = Row * 32} 
  288.   /$01/$CF               {         ADD DI,CX                ;DI = (Row * 160)} 
  289.   /$8B/$8E/>Col          {         MOV CX,[BP+>Col]         ;CX = Column} 
  290.   /$49                   {         DEC CX                   ;Col to 0..79 range} 
  291.   /$D1/$E1               {         SHL CX,1                 ;Account for attribute bytes} 
  292.   /$01/$CF               {         ADD DI,CX                ;DI = (Row * 160) + (Col * 2)} 
  293.   /$8E/$06/>BaseOfScreen {         MOV ES,[>BaseOfScreen]   ;ES:DI points to Base:Row,Col} 
  294.   /$8A/$0E/>WaitForRetrace{        MOV CL,[>WaitForRetrace] ;Grab this before changing DS} 
  295.   /$8C/$D2               {         MOV DX,SS                ;Move SS...} 
  296.   /$8E/$DA               {         MOV DS,DX                ; into DS} 
  297.   /$8D/$B6/>St           {         LEA SI,[BP+>St]          ;DS:SI points to St[0]} 
  298.   /$FC                   {         CLD                      ;Set direction to forward} 
  299.   /$AC                   {         LODSB                    ;AX = Length(St); DS:SI -> St[1]} 
  300.   /$91                   {         XCHG AX,CX               ;CX = Length; AL = Wait} 
  301.   /$E3/$29               {         JCXZ Exit                ;If string empty, Exit} 
  302.   /$8A/$A6/>Attr         {         MOV AH,[BP+>Attr]        ;AH = Attribute} 
  303.   /$D0/$D8               {         RCR AL,1                 ;If WaitForRetrace is False...} 
  304.   /$73/$1D               {         JNC NoWait               ; use NoWait routine} 
  305.   /$BA/$DA/$03           {         MOV DX,$03DA             ;Point DX to CGA status port} 
  306.   /$AC                   {Next:    LODSB                    ;Load next character into AL} 
  307.                          {                                  ; AH already has Attr} 
  308.   /$89/$C3               {         MOV BX,AX                ;Store video word in BX} 
  309.   /$FA                   {         CLI                      ;No interrupts now} 
  310.   /$EC                   {WaitNoH: IN AL,DX                 ;Get 6845 status} 
  311.   /$A8/$08               {         TEST AL,8                ;Check for vertical retrace} 
  312.   /$75/$09               {         JNZ Store                ; In progress? go} 
  313.   /$D0/$D8               {         RCR AL,1                 ;Else, wait for end of} 
  314.   /$72/$F7               {         JC WaitNoH               ; horizontal retrace} 
  315.   /$EC                   {WaitH:   IN AL,DX                 ;Get 6845 status again} 
  316.   /$D0/$D8               {         RCR AL,1                 ;Wait for horizontal} 
  317.   /$73/$FB               {         JNC WaitH                ; retrace} 
  318.   /$89/$D8               {Store:   MOV AX,BX                ;Move word back to AX...} 
  319.   /$AB                   {         STOSW                    ; and then to screen} 
  320.   /$FB                   {         STI                      ;Allow interrupts} 
  321.   /$E2/$E8               {         LOOP Next                ;Get next character} 
  322.   /$EB/$04               {         JMP SHORT Exit           ;Done} 
  323.   /$AC                   {NoWait:  LODSB                    ;Load next character into AL} 
  324.                          {                                  ; AH already has Attr} 
  325.   /$AB                   {         STOSW                    ;Move video word into place} 
  326.   /$E2/$FC               {         LOOP NoWait              ;Get next character} 
  327.   /$1F                   {Exit:    POP DS                   ;Restore DS} 
  328. ); 
  329. End; 
  330.  
  331. Procedure FastWriteV( Var St; Row, Col, Attr : Byte ); 
  332.   {-Works with string variables ONLY. (I made St an untyped parameter 
  333.     only to make this easier to use when type checking is on.) This is 
  334.     just FastWrite optimized for use with string Variables, for times 
  335.     when speed really matters.} 
  336. Begin 
  337. Inline( 
  338.   $1E                    {         PUSH DS} 
  339.   /$31/$C0               {         XOR AX,AX} 
  340.   /$88/$C1               {         MOV CL,AL} 
  341.   /$8A/$6E/<Row          {         MOV CH,[BP+<Row]} 
  342.   /$FE/$CD               {         DEC CH} 
  343.   /$D1/$E9               {         SHR CX,1} 
  344.   /$89/$CF               {         MOV DI,CX} 
  345.   /$D1/$EF               {         SHR DI,1} 
  346.   /$D1/$EF               {         SHR DI,1} 
  347.   /$01/$CF               {         ADD DI,CX} 
  348.   /$8B/$4E/<Col          {         MOV CX,[BP+<Col]} 
  349.   /$49                   {         DEC CX} 
  350.   /$D1/$E1               {         SHL CX,1} 
  351.   /$01/$CF               {         ADD DI,CX} 
  352.   /$8E/$06/>BaseOfScreen {         MOV ES,[>BaseOfScreen]} 
  353.   /$8A/$0E/>WaitForRetrace{        MOV CL,[>WaitForRetrace]} 
  354.   /$C5/$76/<St           {         LDS SI,[BP+<St]          ;DS:SI points to St[0]} 
  355.   /$FC                   {         CLD} 
  356.   /$AC                   {         LODSB} 
  357.   /$91                   {         XCHG AX,CX} 
  358.   /$E3/$28               {         JCXZ Exit} 
  359.   /$8A/$66/<Attr         {         MOV AH,[BP+<Attr]} 
  360.   /$D0/$D8               {         RCR AL,1} 
  361.   /$73/$1D               {         JNC NoWait} 
  362.   /$BA/$DA/$03           {         MOV DX,$03DA} 
  363.   /$AC                   {Next:    LODSB} 
  364.   /$89/$C3               {         MOV BX,AX} 
  365.   /$FA                   {         CLI} 
  366.   /$EC                   {WaitNoH: IN AL,DX} 
  367.   /$A8/$08               {         TEST AL,8} 
  368.   /$75/$09               {         JNZ Store} 
  369.   /$D0/$D8               {         RCR AL,1} 
  370.   /$72/$F7               {         JC WaitNoH} 
  371.   /$EC                   {WaitH:   IN AL,DX} 
  372.   /$D0/$D8               {         RCR AL,1} 
  373.   /$73/$FB               {         JNC WaitH} 
  374.   /$89/$D8               {Store:   MOV AX,BX} 
  375.   /$AB                   {         STOSW} 
  376.   /$FB                   {         STI} 
  377.   /$E2/$E8               {         LOOP Next} 
  378.   /$EB/$04               {         JMP SHORT Exit} 
  379.   /$AC                   {NoWait:  LODSB} 
  380.   /$AB                   {         STOSW} 
  381.   /$E2/$FC               {         LOOP NoWait} 
  382.   /$1F                   {Exit:    POP DS} 
  383. ); 
  384. End; 
  385.  
  386. {------------------------- FastWrite Routines -------------------------} 
  387.  
  388. Procedure RulerLine; 
  389. Var 
  390.   C , J : Byte; 
  391. Begin 
  392.   TextLine := BlankLine; 
  393.   For J := 1 To 79 Do 
  394.     Begin 
  395.       If J Mod 5 = 0 Then 
  396.         TextLine[J] := '+' 
  397.       Else 
  398.         TextLine[J] := '-'; 
  399.       C := 48 + ((J + Offset) Div 10) Mod 10 ; 
  400.       If J Mod 10 = 0 Then 
  401.         TextLine[J] := Chr(C); 
  402.     End; 
  403.   FastWriteV(TextLine,2,1, Attr); 
  404.   If (Wrap) Then   { put margin markers on ruler } 
  405.     Begin 
  406.       Textcolor(14); 
  407.       TextBackGround(Green); 
  408.       if LeftM >= Offset Then 
  409.         Begin 
  410.           GotoXY(LeftM - Offset + 1, 2); 
  411.           Write('|'); 
  412.         End; 
  413.       If RtMrg >= Offset Then 
  414.         Begin 
  415.           GotoXY(RtMrg - Offset + 1, 2); 
  416.           Write('|'); 
  417.         End; 
  418.       TextColor( Fore ); 
  419.       TextBackGround( Back ); 
  420.    End; 
  421. End; 
  422.  
  423. Procedure StatusLine; 
  424. Begin 
  425.   Textline := BlankLine; 
  426.   Insert(' Line:      Column:',TextLine,1); 
  427.   If Insrt Then Insert('Insert ',TextLine,26) 
  428.     Else Insert('OverWrite ',TextLine,25); 
  429.   If Wrap  Then Insert(' WordWrap',TextLine,35) 
  430.     Else Insert('  NoWrap   ',TextLine,35); 
  431.   Insert(' Workfile:',TextLine,47); 
  432.   Insert(Input,TextLine,58); 
  433.   FastWriteV(TextLine,1,1,Attr); 
  434.   RulerLine; 
  435. End; 
  436.  
  437. Procedure WriteLine(Row,Attr:Byte);    { direct write to screen } 
  438. Var Len        : Byte;                 { writes blanks where there is no text} 
  439.     Contents   : ScreenLine; 
  440. Begin 
  441.   TextLine := BlankLine; 
  442.   Contents := Copy(Ln^.Data,Offset,80); 
  443.   Len      := Ord(Contents[0]); 
  444.   Insert(Contents,TextLine,1); 
  445.   If Len = 80 Then TextLine[80] := '+' 
  446.     Else If Len > 0 Then TextLine[80] := '<'; 
  447.   FastWriteV(TextLine,Row,1,Attr); 
  448. End; 
  449.  
  450. Procedure Screen;     { rewrites the bottom 23 lines } 
  451. Var Row   : Byte; 
  452.     TopLn : LPtr; 
  453. Begin                 { makes sure i and ln are in register } 
  454.   Ln := EndLn^.Next; 
  455.   If Top > 1 Then 
  456.    For K := 2 To Top Do 
  457.     Ln := Ln^.Next; 
  458.   TopLn := Ln; 
  459.   For Row := 3 to 25 do 
  460.    Begin 
  461.     WriteLine(Row,Attr); 
  462.     If Ln <> EndLn Then 
  463.      Ln := Ln^.Next; 
  464.    End; 
  465.   Ln  := TopLn; 
  466.   Row := I - Top; 
  467.   While Row > 0 do 
  468.    Begin 
  469.     Ln  := Ln^.Next; 
  470.     Row := Row - 1; 
  471.    End; 
  472. End; 
  473.  
  474. Procedure Help; 
  475. Begin 
  476.   Window(1, 1, 80, 25); 
  477.   ClrScr; GetVideoMode; 
  478.   FastWrite('╔══════════════════════════════════════════════════════════════════════════════╗', 1, 1, Attr ); GetVideoMode ; 
  479.   FastWrite('║                    Window Editor -- by TurboWorks Software                   ║', 2, 1, Attr ); GetVideoMode ; 
  480.   FastWrite('║ ┌───────────────────────┐ ┌───────────────────────┐ ┌──────────────────────┐ ║', 3, 1, Attr ); GetVideoMode ; 
  481.   FastWrite('║ │  ^X      line up      │ │  ^S     column left   │ │  Alt-A   Ascii       │ ║', 4, 1, Attr ); GetVideoMode ; 
  482.   FastWrite('║ │  ^E      line down    │ │  ^D     column right  │ │  Alt-B   Back Color  │ ║', 5, 1, Attr ); GetVideoMode ; 
  483.   FastWrite('║ │  ^C      page up      │ │  ^PgUp  file home     │ │  Alt-C   Copy Block  │ ║', 6, 1, Attr ); GetVideoMode ; 
  484.   FastWrite('║ │  ^R      page down    │ │  ^PgDn  file end      │ │  Alt-D   Del  Block  │ ║', 7, 1, Attr ); GetVideoMode ; 
  485.   FastWrite('║ │  ^K      quit         │ │  ^N     insert line   │ │  Alt-F   Fore Color  │ ║', 8, 1, Attr ); GetVideoMode ; 
  486.   FastWrite('║ │  ^P      set margins  │ │  ^Y     delete line   │ │  Alt-G   Goto Block  │ ║', 9, 1, Attr ); GetVideoMode ; 
  487.   FastWrite('║ │  ^BkSp   delete word  │ │  BkSp   delete char   │ │  Alt-M   Move Block  │ ║',10, 1, Attr ); GetVideoMode ; 
  488.   FastWrite('║ │  ^V      toggle ins   │ │  Ins    toggle insert │ │  Alt-N   Clr  Marks  │ ║',11, 1, Attr ); GetVideoMode ; 
  489.   FastWrite('║ │  ^W      window dn    │ │                       │ │  Alt-S   Beg  Block  │ ║',12, 1, Attr ); GetVideoMode ; 
  490.   FastWrite('║ │  ^Z      window up    │ │  Del    delete char   │ │  Alt-T   End  Block  │ ║',13, 1, Attr ); GetVideoMode ; 
  491.   FastWrite('║ │  ^Home   erase bol    │ │  Home   beg of line   │ │                      │ ║',14, 1, Attr ); GetVideoMode ; 
  492.   FastWrite('║ │  ^End    erase eol    │ │  End    end of line   │ │                      │ ║',15, 1, Attr ); GetVideoMode ; 
  493.   FastWrite('║ │  ^F      next word    │ │  Tab    next tab stop │ │                      │ ║',16, 1, Attr ); GetVideoMode ; 
  494.   FastWrite('║ │  ^A      prev word    │ │  BTab   last tab stop │ │                      │ ║',17, 1, Attr ); GetVideoMode ; 
  495.   FastWrite('║ │  F1      help         │ │  F6     replace       │ │                      │ ║',18, 1, Attr ); GetVideoMode ; 
  496.   FastWrite('║ │  F2      clear marks  │ │  F7     page up       │ │                      │ ║',19, 1, Attr ); GetVideoMode ; 
  497.   FastWrite('║ │  F3      quit         │ │  F8     page down     │ │                      │ ║',20, 1, Attr ); GetVideoMode ; 
  498.   FastWrite('║ │  F4      set margins  │ │  F9     prev word     │ │                      │ ║',21, 1, Attr ); GetVideoMode ; 
  499.   FastWrite('║ │  F5      search       │ │  F10    next word     │ │                      │ ║',22, 1, Attr ); GetVideoMode ; 
  500.   FastWrite('║ └───────────────────────┘ └───────────────────────┘ └──────────────────────┘ ║',23, 1, Attr ); GetVideoMode ; 
  501.   FastWrite('║                  Press any key to return to your editing.....                ║',24, 1, Attr ); GetVideoMode ; 
  502.   FastWrite('╚══════════════════════════════════════════════════════════════════════════════╝',25, 1, Attr ); GetVideoMode ; 
  503.   Repeat 
  504.   Until KeyPressed; 
  505.   Ch := ReadKey; 
  506.   StatusLine; 
  507.   Screen; 
  508. End; 
  509.  
  510. Procedure PageUp; 
  511. Begin 
  512.   If Top > 22 Then Begin 
  513.     Top := Top - 22; I := I - 22; End 
  514.   Else Begin 
  515.     I := I - Top + 1; Top := 1; End; 
  516.   Screen; 
  517. End; 
  518.  
  519. Procedure PageDown; 
  520. begin 
  521.   If Top <= (NLines - 44) Then 
  522.    Begin 
  523.     Top := Top + 22; 
  524.     I := I + 22; 
  525.    End 
  526.   Else If NLines > 22 Then 
  527.    Begin 
  528.     I := I - Top + NLines - 22; 
  529.     Top := NLines - 22; 
  530.    End; 
  531.   Screen; 
  532. End; 
  533.  
  534. Procedure Cursor;       { make sure the cursor is visible on the screen } 
  535. Var ii,jj,chgd : Word; 
  536.     Shifted    : Boolean; 
  537. Begin 
  538.   Shifted := False; 
  539.   If I < 1 Then 
  540.     Begin 
  541.       I  := 1; 
  542.       Ln := EndLn^.Next; 
  543.     End; 
  544.   If I > NLines Then 
  545.     Begin 
  546.       I  := NLines; 
  547.       Ln := EndLn^.Last; 
  548.     End; 
  549.   If J < 1 Then 
  550.     J := 1; 
  551.   If J > MaxWidth Then 
  552.     J := MaxWidth; 
  553.   Len := Ord(Ln^.Data[0]); 
  554.   If ( J > Offset + 77 ) Then 
  555.     Begin 
  556.       Offset  := 10 * ( J Div 10 ) - 59; 
  557.       Shifted := True; 
  558.     End; 
  559.   If J < Offset Then 
  560.     Begin 
  561.       Offset  := 10 * ( ( J - 10 ) Div 10 ) + 1; 
  562.       Shifted := True; 
  563.     End; 
  564.   If I < Top Then 
  565.     Begin 
  566.       Top     := I; 
  567.       Shifted := True; 
  568.     End; 
  569.   If I > Top + 22 Then 
  570.     Begin 
  571.       Top     := I - 22; 
  572.       Shifted := True; 
  573.     End; 
  574.   If Shifted Then 
  575.     Begin 
  576.       RulerLine; 
  577.       Screen; 
  578.     End; 
  579.   Str(i:4,ii); 
  580.   Str(j:3,jj); 
  581.   If Changed Then Chgd := ' * ' 
  582.     Else Chgd := '   '; 
  583.   FastWriteV(ii,1,7,Attr);    GetVideoMode; 
  584.   FastWriteV(jj,1,20,Attr);   GetVideoMode; 
  585.   FastWriteV(Chgd,1,76,Attr); GetVideoMode; 
  586.   GotoXY( J - Offset + 1, i - top + 3); 
  587. End; 
  588.  
  589. Procedure CursorLeft; 
  590. Begin 
  591.   J := J - 1; 
  592.   If J < 1 Then 
  593.     Begin 
  594.       I := I - 1; 
  595.       If I < 1 Then 
  596.         Begin 
  597.           I  := 1; 
  598.           J  := 1; 
  599.           Ln := EndLn^.Next ; 
  600.           Exit; 
  601.         End; 
  602.       J := Length(Ln^.Last^.Data) + 1 ; 
  603.       Ln := Ln^.Last ; 
  604.    End 
  605. End; 
  606.  
  607. Procedure CursorRight; 
  608. Begin 
  609.   j := j + 1; 
  610.   if j > MaxWidth then 
  611.     Begin 
  612.       i := i + 1; 
  613.       If I > NLines then 
  614.         Begin 
  615.           I  := NLines; 
  616.           Ln := EndLn^.Last ; 
  617.         End 
  618.       Else If I < NLines Then 
  619.         Ln := Ln^.Next ; 
  620.       J := 1; 
  621.     End; 
  622. End; 
  623.  
  624. Procedure ParaForm;  { set margins, wordwrap on/off } 
  625. Begin 
  626.   GotoXY(1,1); ClrEol; 
  627.   Write('WordWrap? '); 
  628.   If YN Then 
  629.     Wrap := True 
  630.   Else 
  631.     Begin 
  632.       Wrap  := False; 
  633.       LeftM := 1; 
  634.       LWord := ''; 
  635.     End; 
  636.   If Wrap Then 
  637.     Begin 
  638.       GotoXY(15,1); Write('Left margin: '); 
  639.       ReadLn(LeftM); 
  640.       LWord := ''; 
  641.       While Length(LWord) < LeftM - 1 Do 
  642.         LWord := LWord + ' '; 
  643.       RulerLine; 
  644.       Repeat 
  645.         GotoXY(35,1); Write('Right margin: '); 
  646.         ReadLn(RtMrg); 
  647.       Until RtMrg > LeftM + 24; 
  648.     End; 
  649.   ClrScr; 
  650.   StatusLine; 
  651.   Screen; 
  652. End;    { ParaForm } 
  653.  
  654. Procedure InsertLn(contents:line);  {insert after current line} 
  655. Begin 
  656.   New(NextLn); 
  657.   NextLn^.Data := Contents; 
  658.   NextLn^.Last := Ln; 
  659.   NextLn^.Next := Ln^.Next; 
  660.   Ln^.Next^.Last := NextLn; 
  661.   Ln^.Next := NextLn; 
  662.   NLines   := NLines + 1; 
  663. End; 
  664.  
  665. Procedure CutLine;    { start new line after <CR> } 
  666. Var 
  667.   More : Line; 
  668. Begin 
  669.   More := Copy(Ln^.Data,J,Len-J+1); 
  670.   Delete(Ln^.Data,J,Len-J+1); 
  671.   InsertLn(LWord + More); 
  672.   i := i + 1; 
  673.   j := LeftM; 
  674.   Screen; 
  675. End; 
  676.  
  677. Procedure WordWrap; 
  678. Begin 
  679.   N := 0; 
  680.   Repeat 
  681.     J := J - 1; 
  682.     N := N + 1; 
  683.   Until (Ln^.Data[J] = ' ') Or (J = 1); 
  684.   J   := J + 1; 
  685.   Len := Len + 1; 
  686.   CutLine; 
  687.   J := LeftM + N - 1 ; 
  688. end; 
  689.  
  690. Procedure StackLine;   { put current line on top of previous line } 
  691. begin 
  692.   j := length(ln^.last^.data)+1; 
  693.   ln^.last^.data := ln^.last^.data + ln^.data; 
  694.   ln^.last^.next := ln^.next;     { isolate current line } 
  695.   ln^.next^.last := ln^.last; 
  696.   Dispose(Ln);                    { and zap it} 
  697.   I := I - 1; 
  698.   NLines := NLines - 1; 
  699.   Screen; 
  700. End; 
  701.  
  702. Procedure DeleteLine; 
  703. Begin 
  704.   Ln^.Last^.Next := Ln^.Next;     { isolate current line } 
  705.   Ln^.Next^.Last := Ln^.Last; 
  706.   Dispose(Ln);                    { and zap it} 
  707.   J  := 1 ;  I := I - 1; 
  708.   NLines  := NLines - 1; 
  709.   Changed := True; 
  710.   StatusLine; 
  711.   Screen; 
  712. End; 
  713.  
  714. Procedure DeleteEOL; 
  715. Begin 
  716.   If J < MaxWidth Then 
  717.     Begin 
  718.       Ln^.Data := Copy ( Ln^.Data, 1 , J - 1 ) ; 
  719.       Changed := True; 
  720.     End; 
  721.   If J > 1 Then 
  722.     J := J - 1; 
  723.   StatusLine ; 
  724.   Screen ; 
  725. End; 
  726.  
  727. Procedure DeleteBOL; 
  728. Begin 
  729.   If J > 1 Then 
  730.     Begin 
  731.       Ln^.Data := Copy ( BlankLine, 1, J ) + Copy ( Ln^.Data, J + 1 , MaxWidth ) ; 
  732.       Changed := True; 
  733.     End; 
  734.   If J < MaxWidth Then 
  735.     J := J + 1; 
  736.   StatusLine ; 
  737.   Screen ; 
  738. End; 
  739.  
  740. Procedure DeleteWord; 
  741. Var 
  742.   EndW : Byte; 
  743. Begin 
  744.   While (( Copy(Ln^.Data,J,1) <> ' ' ) And ( J > 0 )) Do 
  745.     J := J - 1 ; 
  746.   If J = 0 Then 
  747.     J := 1 ; 
  748.   EndW := J + 1; 
  749.   While (( Copy(Ln^.Data,EndW,1) <> ' ' ) And ( EndW < MaxWidth )) Do 
  750.     EndW := EndW + 1 ; 
  751.   If J = 1 Then 
  752.     Ln^.Data := Copy ( Ln^.Data , EndW + 1, MaxWidth ) 
  753.   Else 
  754.     Ln^.Data := Copy ( Ln^.Data, 1, J ) + Copy ( Ln^.Data , EndW + 1, MaxWidth ) ; 
  755.   Changed := True ; 
  756.   StatusLine ; 
  757.   Screen ; 
  758. End; 
  759.  
  760. Procedure PrevWord; 
  761. Begin 
  762. (* if i am in a word then skip to the space *) 
  763.   While (Not ((Ln^.Data[j] = ' ') Or ( j >= Length(Ln^.Data) ))) And 
  764.          (( i <> 1 ) Or ( j <> 1 )) Do 
  765.       CursorLeft; 
  766. (* find end of previous word *) 
  767.   While ((Ln^.Data[j] = ' ') Or ( j >= Length(Ln^.Data) )) And 
  768.          (( i <> 1 ) Or ( j <> 1 )) Do 
  769.       CursorLeft; 
  770. (* find start of previous word *) 
  771.   While (Not ((Ln^.Data[j] = ' ') Or ( j >= Length(Ln^.Data) ))) And 
  772.          (( i <> 1 ) Or ( j <> 1 )) do 
  773.       CursorLeft; 
  774.    CursorRight; 
  775. End; 
  776.  
  777. Procedure NextWord; 
  778. Begin 
  779. (* if i am in a word, then move to the whitespace *) 
  780.   while (not ((Ln^.Data[j] = ' ') or ( j >= length(Ln^.Data)))) and 
  781.         ( i < NLines ) do 
  782.     CursorRight; 
  783. (* skip over the space to the other word *) 
  784.   while ((Ln^.Data[j] = ' ') or ( j >= Length(Ln^.Data))) and 
  785.          ( i < NLines ) do 
  786.     CursorRight; 
  787. End; 
  788.  
  789. Procedure Tab; 
  790. Begin 
  791.   If J < MaxWidth Then 
  792.     Begin 
  793.       Repeat 
  794.         J := J + 1; 
  795.       Until ( TabSet [J]= True ) Or ( J = MaxWidth ); 
  796.     End; 
  797. End; 
  798.  
  799. Procedure BackTab; 
  800. Begin 
  801.   If J > 1 Then 
  802.     Begin 
  803.       Repeat 
  804.          J := J - 1; 
  805.       Until ( TabSet [J]= True ) Or ( J = 1 ); 
  806.   End; 
  807. End; 
  808.  
  809. Procedure Search; 
  810. var 
  811.   Temp              : ScreenLine; 
  812.   Pointer, Position : Integer; 
  813.   LocPtr , Location : Integer; 
  814.   TmpPtr            : LPtr; 
  815. Begin 
  816.    Window(1, 1, 80, 25); 
  817.    GotoXY(1, 1); ClrEol; 
  818.    Write('Search:     Enter string: <',SearchString,'> '); 
  819.    Temp := ''; 
  820.    ReadLn(Temp); 
  821.    If Temp <> '' Then 
  822.       SearchString := Temp; 
  823.    If Length( SearchString ) = 0 Then 
  824.      Begin 
  825.        StatusLine; 
  826.        Screen; 
  827.        Exit; 
  828.      End; 
  829.    GotoXY(1,1); ClrEol; 
  830.    Write('Searching...'); 
  831.    NextWord; 
  832.    TmpPtr := Ln; 
  833.    LocPtr := J; 
  834.    For Location := I + 1 To NLines Do 
  835.      begin 
  836.        (* look for matches on this line *) 
  837.        Pointer := Pos (SearchString, Copy(Ln^.Data,LocPtr,MaxWidth)); 
  838.        (* if there was a match then get ready to print it *) 
  839.        If (Pointer > 0) Then 
  840.          Begin 
  841.            I := Location - 1 ; 
  842.            J := Pointer; 
  843.            StatusLine; 
  844.            Screen; 
  845.            Exit; 
  846.          End 
  847.        Else If Location <> NLines Then 
  848.          Begin 
  849.            Ln := Ln^.Next ; 
  850.            LocPtr := 1 ; 
  851.          End 
  852.    End; 
  853.    Window(1, 1, 80, 25); 
  854.    GotoXY(1, 1); ClrEol; 
  855.    Write('Search string not found.  Press any key to exit...'); 
  856.    Repeat 
  857.    Until KeyPressed; 
  858.    Ch := ReadKey; 
  859.    Ln := TmpPtr ; 
  860.    StatusLine; 
  861.    Screen; 
  862. End; 
  863.  
  864. Procedure Replace; 
  865. Var 
  866.   Temp               : ScreenLine; 
  867.   Pointer , Position : Integer; 
  868.   Location, Len      : Integer; 
  869. Begin 
  870.   Window(1, 1, 80, 25); 
  871.   GotoXY(1, 1); ClrEol; 
  872.   Write('Replace:     Enter search string: <',SearchString,'> '); 
  873.   Temp := ''; 
  874.   ReadLn(Temp); 
  875.   If Temp <> '' Then 
  876.     SearchString := Temp; 
  877.   If Length(SearchString) = 0 Then 
  878.     Begin 
  879.       StatusLine; 
  880.       Screen; 
  881.       Exit; 
  882.     End; 
  883.   GotoXY(1, 1); ClrEol; 
  884.   Write('Replace:     Enter replacement string: <',replacement,'> '); 
  885.   Temp := ''; 
  886.   ReadLn(Temp); 
  887.   if Temp <> '' Then 
  888.     Replacement := Temp; 
  889.   Len := Length (Replacement); 
  890.   Ln  := EndLn^.Next ; 
  891.   I   := 1 ;  J := 1 ; 
  892.   GotoXY(1, 1);  ClrEol; 
  893.   Write('Searching...'); 
  894.   For Location := 1 to NLines Do 
  895.     Begin 
  896.       (* look for matches on this line *) 
  897.       Position := Pos (SearchString, Ln^.Data ); 
  898.       (* if there was a match then get ready to print it *) 
  899.       While (Position > 0) Do 
  900.         Begin 
  901.           I   := Location ; 
  902.           J   := Position ; 
  903.           If Location > 8 Then 
  904.             Top := Location - 8 
  905.           Else 
  906.             Top := 1 ; 
  907.           Screen ; 
  908.           TextColor( Back ); 
  909.           TextBackGround( Fore ); 
  910.           GotoXY( J - Offset + 1, I - Top + 3 ); 
  911.           Write ( SearchString ); 
  912.           TextColor( Fore ); 
  913.           TextBackGround( Back ); 
  914.           GotoXY(1, 1); ClrEol; 
  915.           Write('Replace (Y/N/ESC)? '); 
  916.           Ch := ReadKey; 
  917.           If Ord (Ch)= 27 Then 
  918.             Begin 
  919.               I  := 1; 
  920.               J  := 1; 
  921.               Ln := EndLn^.Next ; 
  922.               StatusLine; 
  923.               Screen; 
  924.               Exit; 
  925.             End; 
  926.           If Ch In ['y','Y'] Then 
  927.             Begin 
  928.               Ln^.Data := Copy (Ln^.Data, 1, Position - 1) + Replacement + 
  929.                               Copy (Ln^.Data, Position + Length (SearchString), MaxWidth); 
  930.               Position := Pos (SearchString, Copy (Ln^.Data, Position + Len + 1,MaxWidth)) ; 
  931.             End 
  932.           Else 
  933.             Position := Pos (SearchString, Copy (Ln^.Data, Position + Length(SearchString) + 1,MaxWidth)) ; 
  934.         End; 
  935.       Ln := Ln^.Next ; 
  936.       GotoXY(1, 1);  ClrEol; 
  937.       Write('Searching...'); 
  938.     End; 
  939.   Window(1, 1, 80, 25); 
  940.   GotoXY(1, 1); ClrEol; 
  941.   Write('End of replace.  Press any key to exit...'); 
  942.   Repeat 
  943.   Until KeyPressed; 
  944.   Ch := ReadKey; 
  945.   Ln := EndLn^.Next ; 
  946.   I  := 1 ; 
  947.   J  := 1 ; 
  948.   StatusLine; 
  949.   Screen; 
  950. End; 
  951.  
  952. Procedure ClearMarks ; 
  953. Begin 
  954.   IBeg := 0 ; 
  955.   IEnd := 0 ; 
  956.   BlockBeg := Nil ; 
  957.   BlockEnd := Nil ; 
  958. End; 
  959.  
  960. Procedure InsertMark( Mark : Char ); 
  961. Begin 
  962.   If Mark = 'B' Then 
  963.     Begin 
  964.       If BlockBeg = Nil Then 
  965.         Begin 
  966.           BlockBeg := Ln ; 
  967.           IBeg     := I  ; 
  968.         End 
  969.       Else  { BlockBeg Already Defined } 
  970.         Write(#7); 
  971.     End; 
  972.   If Mark = 'E' Then 
  973.     Begin 
  974.       If BlockEnd = Nil Then 
  975.         Begin 
  976.           BlockEnd := Ln ; 
  977.           IEnd     := I  ; 
  978.         End 
  979.       Else  { BlockEnd Already Defined } 
  980.         Write(#7); 
  981.     End; 
  982. End; 
  983.  
  984. Procedure GotoBlock ; 
  985. Begin 
  986.   If BlockBeg <> Nil Then 
  987.     Begin 
  988.       Ln  := BlockBeg ; 
  989.       I   := IBeg; 
  990.       J   := 1 ; 
  991.       If ( I >= 12 ) Then 
  992.         Top := I - 8; 
  993.       StatusLine ; 
  994.       Screen ; 
  995.     End; 
  996. End; 
  997.  
  998. Procedure DeleteBlock; 
  999. Var 
  1000.   TPtr   : LPtr; 
  1001. Begin 
  1002.   If IEnd < IBeg Then 
  1003.     Exit; 
  1004.   Ln := BlockEnd ; 
  1005.   I  := IEnd ; 
  1006.   Repeat 
  1007.     TPtr           := Ln^.Last;     { save location of previous line } 
  1008.     Ln^.Last^.Next := Ln^.Next;     { isolate current line } 
  1009.     Ln^.Next^.Last := Ln^.Last; 
  1010.     Dispose(Ln);                    { and zap it} 
  1011.     J  := 1 ;  I := I - 1; 
  1012.     NLines  := NLines - 1; 
  1013.     Ln      := TPtr; 
  1014.   Until Ln = BlockBeg^.Last ; 
  1015.   If I >= 12 Then 
  1016.     Top := I - 8 
  1017.   Else 
  1018.     Top := 1 ; 
  1019.   Changed := True; 
  1020.   ClearMarks; 
  1021.   StatusLine; 
  1022.   Screen; 
  1023. End; 
  1024.  
  1025. Procedure CopyBlock; 
  1026. var 
  1027.   TPtr : LPtr ; 
  1028.   Size : Integer; 
  1029. Begin 
  1030.   If IEnd < IBeg then 
  1031.     Exit; 
  1032.   If (IBeg < I) And (I <= IEnd) Then 
  1033.     Exit; 
  1034.   Size := IEnd - IBeg - 1;  { exclude markers } 
  1035.   If Size = 0 Then 
  1036.     Exit; 
  1037.   If NLines + Size <= MaxLines Then 
  1038.     Begin 
  1039.       Repeat 
  1040.           InsertLn (BlockEnd^.Data) ; 
  1041.           BlockEnd := BlockEnd^.Last ; 
  1042.           NLines   := NLines + 1 ; 
  1043.       Until BlockEnd = BlockBeg^.Last ; 
  1044.     End 
  1045.   Else 
  1046.     Write(#7); 
  1047.   Changed := True; 
  1048.   ClearMarks; 
  1049.   StatusLine; 
  1050.   Screen; 
  1051. End; 
  1052.  
  1053. Procedure MoveBlock; 
  1054. Var 
  1055.   Size : Integer; 
  1056.   TPtr : LPtr; 
  1057. Begin 
  1058.   If IEnd < IBeg Then 
  1059.     Exit; 
  1060.   If (IBeg <= I) And (I <= IEnd + 1) Then 
  1061.     Exit; 
  1062.   Size := IEnd - IBeg + 1; 
  1063.   If NLines + Size <= MaxLines Then 
  1064.     Begin 
  1065.       TPtr := Ln^.Next ; 
  1066.       BlockBeg^.Last^.Next := BlockEnd^.Next ; 
  1067.       BlockEnd^.Next^.Last := BlockBeg^.Last ; 
  1068.       Ln^.Next   := BlockBeg ; 
  1069.       TPtr^.Last := BlockEnd ; 
  1070.       BlockBeg^.Last := Ln ; 
  1071.       BlockEnd^.Next := TPtr ; 
  1072.     End 
  1073.   Else 
  1074.     Write(#7); 
  1075.   Changed := True; 
  1076.   ClearMarks; 
  1077.   StatusLine; 
  1078.   Screen; 
  1079. End; 
  1080.  
  1081. Procedure WriteBlock ; 
  1082. Var 
  1083.   TPtr : LPtr ; 
  1084. Begin 
  1085.   If ((BlockBeg = Nil) Or (BlockEnd = Nil)) Then 
  1086.     Exit ; 
  1087.   If IBeg + 1 < IEnd Then 
  1088.     Begin 
  1089.       GotoXY(1,1); For J := 1 To 45 Do Write(' '); 
  1090.       GotoXY(1,1); Write('Write Block To Disk ? '); 
  1091.       If YN Then 
  1092.         Begin 
  1093.           Write('as: '); ReadLn(OutPut); 
  1094.           If OutPut = '' Then 
  1095.             OutPut := Input; 
  1096.           Capitalize(OutPut); 
  1097.           GotoXY(40,1); WriteLn('    Writing to disk as ',OutPut); 
  1098.           Assign(WorkFile,OutPut); 
  1099.           ReWrite(WorkFile); 
  1100.           TPtr := BlockBeg; 
  1101.           Repeat 
  1102.             WriteLn(WorkFile,TPtr^.Data); 
  1103.             TPtr := TPtr^.Next 
  1104.           Until TPtr = BlockEnd; 
  1105.           Close(WorkFile); 
  1106.        End; 
  1107.     End 
  1108.   Else 
  1109.     Write(#7); 
  1110.   StatusLine ; 
  1111.   Screen ; 
  1112. End; 
  1113.  
  1114. Procedure AddChar;       { keyboard entry } 
  1115. begin 
  1116.   Changed := True; 
  1117.   While J > Len + 1 Do 
  1118.     Begin 
  1119.       Ln^.Data := Ln^.Data + ' ' ; 
  1120.       Len := Len + 1 ; 
  1121.     End; 
  1122.   If J = Len + 1 Then 
  1123.     Ln^.Data := Ln^.Data + Ch 
  1124.   Else If InSrt Then 
  1125.     Insert(Ch,Ln^.Data,J) 
  1126.   Else 
  1127.     Ln^.Data[J] := Ch; 
  1128.   J := J + 1; 
  1129.   WriteLine( I - Top + 3,Attr); 
  1130.   If  (J > RtMrg + 2) And Wrap Then 
  1131.     WordWrap; 
  1132. End; 
  1133.  
  1134. Procedure Ascii; 
  1135. Var 
  1136.   AscNo, Repeats, R : Integer; 
  1137.   AsciiLine         : ScreenLine; 
  1138. Begin 
  1139.   AsciiLine := ''; 
  1140.   GotoXY( 1, 1); ClrEol; 
  1141.   Write('Enter ASCII code number: --- '); 
  1142.   GotoXY(26,1); 
  1143.   Readln(AscNo); 
  1144.   GotoXY(1,1); 
  1145.   Write('Enter number of repeats: --  '); 
  1146.   GotoXY(26,1); 
  1147.   ReadLn(Repeats); 
  1148.   If Not(Repeats In [1..79]) Then 
  1149.     Repeats := 1; 
  1150.   If (AscNo > 0) And (AscNo < 256) Then 
  1151.     Begin 
  1152.       For R := 1 To Repeats Do 
  1153.         Begin 
  1154.           Ch := Chr(AscNo); 
  1155.           AsciiLine := AsciiLine + Ch ; 
  1156.         End; 
  1157.     End; 
  1158.   While J > Length(Ln^.Data) + 1 Do 
  1159.     Begin 
  1160.       Ln^.Data := Ln^.Data + ' ' ; 
  1161.       Len := Len + 1 ; 
  1162.     End; 
  1163.   J := J - 1; 
  1164.   If J = Length(Ln^.Data) + 1 Then 
  1165.     Ln^.Data := Ln^.Data + AsciiLine 
  1166.   Else If InSrt Then 
  1167.     Insert(AsciiLine,Ln^.Data,J) 
  1168.   Else 
  1169.     Ln^.Data := Copy(Ln^.Data,1,J) + AsciiLine + Copy(Ln^.Data,J + Length(AsciiLine),128); 
  1170.   Changed    := True; 
  1171.   StatusLine; 
  1172.   Screen; 
  1173. End; 
  1174.  
  1175. Procedure Leave; 
  1176. Var 
  1177.   Trash : Char; 
  1178. Begin 
  1179.   VideoOff; 
  1180.   Repeat 
  1181.   Until KeyPressed; 
  1182.   Trash := ReadKey; 
  1183.   If (Trash = #0) And (KeyPressed) Then 
  1184.     Trash := ReadKey; 
  1185.   VideoOn; 
  1186. End; 
  1187.  
  1188. Procedure Colors; 
  1189. Begin 
  1190.   Case Ch Of 
  1191.      #48 : Back  := (Back + 1) Mod 8; 
  1192.      #33 : Fore  := (Fore + 1) Mod 16; 
  1193.   End; 
  1194.   Attr := Attribute( Fore, Back ); 
  1195.   StatusLine; 
  1196.   Screen; 
  1197. End; 
  1198.  
  1199. Procedure Command; 
  1200. Begin 
  1201.   If Ch = #0 Then 
  1202.     If KeyPressed Then Ch := ReadKey; { keypad input } 
  1203.   Case Ch Of 
  1204. {alt A}  #30 : Ascii; 
  1205. {alt B, alt F}  #48,#33 : If Mode <> 7 Then Colors; 
  1206. {alt C}  #46 : CopyBlock; 
  1207. {alt D}  #32 : DeleteBlock; 
  1208. {alt G}  #34 : GotoBlock; 
  1209. {alt H}  #35 : Help; 
  1210. {alt K}  #37 : ; 
  1211. {alt L}  #38 : Leave; 
  1212. {alt M}  #50 : MoveBlock; 
  1213. {alt N}  #49 : ClearMarks; 
  1214. {alt S}  #31 : InsertMark('B'); 
  1215. {alt T}  #20 : InsertMark('E'); 
  1216. {alt W}  #17 : WriteBlock; 
  1217. {alt X}  #45 : Finished := True; 
  1218. {tab}     #9 : Tab; 
  1219. {bktab}  #15 : BackTab; 
  1220. {F1}     #59 : Help; 
  1221. {F2}     #60 : ClearMarks; 
  1222. {F3}     #61 : Finished := True; 
  1223. {F4}     #62 : ParaForm ; 
  1224. {F5}     #63 : Search ; 
  1225. {F6}     #64 : Replace; 
  1226. {F7}     #65 : PageUp ; 
  1227. {F8}     #66 : PageDown; 
  1228. {F9}     #67 : PrevWord; 
  1229. {F10}    #68 : NextWord; 
  1230. {home}   #71 : J := LeftM; 
  1231. {end }   #79 : J := Len + 1; 
  1232. {^home} #119 : DeleteBOL; 
  1233. {^end } #117 : DeleteEOL; 
  1234. {^A} #116,#1 : PrevWord; 
  1235. {^D} #77, #4 : J := J + 1; 
  1236. {^S} #75,#19 : If J > 1 Then 
  1237.                  J := J - 1; 
  1238. {^E} #72, #5 : If I > 1 Then 
  1239.                  Begin 
  1240.                    I := I - 1; 
  1241.                    Ln := Ln^.Last; 
  1242.                  End; 
  1243. {^F} #115,#6 : NextWord; 
  1244. {^X} #80,#24 : If I < NLines Then 
  1245.                  Begin 
  1246.                    I  := I + 1; 
  1247.                    Ln := Ln^.Next; 
  1248.                  End; 
  1249. {del}#83, #7 : Begin 
  1250.                  Delete(Ln^.Data,J,1); 
  1251.                  WriteLine(I - Top + 3,Attr); 
  1252.                End; 
  1253. { <-- }   #8 : If J = 1 Then 
  1254.                  StackLine 
  1255.                Else 
  1256.                  Begin 
  1257.                    J := J - 1; 
  1258.                    Delete(Ln^.Data,J,1); 
  1259.                    Cursor; 
  1260.                    WriteLine(i - Top + 3,Attr); 
  1261.                  End; 
  1262. {^<--}  #127 : DeleteWord; 
  1263. {Enter}  #13 : Begin 
  1264.                  If InSrt Then 
  1265.                    Begin 
  1266.                      If J = Len Then 
  1267.                        J := J + 1; 
  1268.                      CutLine; 
  1269.                    End 
  1270.                  Else 
  1271.                    Begin 
  1272.                      I := I + 1 ; 
  1273.                      J := 1 ; 
  1274.                      Ln^ := Ln^.Next^ 
  1275.                    End; 
  1276.                End; 
  1277. {^R} #73,#18 : PageUp; 
  1278. {^C} #81, #3 : PageDown; 
  1279. {^PgUp} #132 : Begin 
  1280.                  I   := 1; 
  1281.                  Top := 1; 
  1282.                  Ln  := FirstLn; 
  1283.                  Screen; 
  1284.                End; 
  1285. {^PgDn} #118 : Begin 
  1286.                  I   := NLines; 
  1287.                  Top := NLines - 22; 
  1288.                  Ln  := EndLn; 
  1289.                  Screen; 
  1290.                End; 
  1291. {^Y}     #25 : DeleteLine; 
  1292. {^N}     #14 : Begin 
  1293.                  Ln := Ln^.Last; 
  1294.                  InsertLn(''); 
  1295.                  Screen; 
  1296.                End; 
  1297. {Ins}#22,#82 : Begin 
  1298.                  If InSrt Then 
  1299.                    InSrt := False 
  1300.                  Else 
  1301.                    InSrt := True; 
  1302.                  StatusLine; 
  1303.                End; 
  1304. {^P}     #16 : ParaForm; 
  1305. {^W}     #23 : If Top > 1 Then 
  1306.                  Begin 
  1307.                    Top := Top - 1; 
  1308.                    I := I - 1; 
  1309.                    Screen; 
  1310.                  End; 
  1311. {^Z}     #26 : If Top < NLines + 22 Then 
  1312.                  Begin 
  1313.                    Top := Top + 1; 
  1314.                    I := I + 1; 
  1315.                    Screen; 
  1316.                  End; 
  1317. {^K}     #11 : Finished := True; 
  1318.           Else Begin 
  1319.             GotoXY(1,1); WriteLn('****** COMMAND NOT RECOGNIZED ******                    '); 
  1320.             Beep; StatusLine; 
  1321.           End; 
  1322.    End; {case} 
  1323. End; 
  1324.  
  1325. Begin {Main} 
  1326.   CheckBreak  := False; 
  1327.   DirectVideo := True; 
  1328.   ClearMarks  ; 
  1329.   GetVideoMode; 
  1330.   IF BaseOfScreen = $B000 Then Begin 
  1331.         Fore := White; 
  1332.         Back := Black; 
  1333.      End 
  1334.   Else Begin 
  1335.         Fore := Blue; { make these whatever you want } 
  1336.         Back := Black; 
  1337.      End; 
  1338.   Attr  := Attribute( Fore, Back ); 
  1339.   TextColor( Fore ); 
  1340.   TextBackground( Back ); 
  1341.   ClrScr; 
  1342.   BlankLine := ''; 
  1343.   For J := 1 To 80 Do 
  1344.     BlankLine := BlankLine + ' '; 
  1345.   For I := 1 To MaxWidth Do 
  1346.     TabSet[I]:=( I Mod 8 ) = 1; 
  1347.   FileFound := False; 
  1348.   ReadFile; 
  1349.   If FileFound Then Begin 
  1350.     FirstLn^.Last := EndLn ; 
  1351.     EndLn^.Next   := FirstLn ;    { close chain, endless loop } 
  1352.     J    := 1;   I      := 1 ; 
  1353.     Top  := 1;   Offset := 1 ; 
  1354.     Find := '.'; Repl   := ''; 
  1355.     Nbl  := 0;   Lword  := ''; 
  1356.     SearchString := ''; Finished := False; 
  1357.     Replacement  := ''; Changed  := False; 
  1358.     ClrScr; 
  1359.     StatusLine; 
  1360.     Screen; 
  1361.     Repeat 
  1362.       Cursor; 
  1363.       Ch := ReadKey; 
  1364.       Case Ch Of 
  1365.         #0..#31,#127 : Command; 
  1366.                 Else   AddChar; 
  1367.       End; 
  1368.     Until Finished; 
  1369.     If Changed Then WriteFile; 
  1370.   End;  {FileFound} 
  1371.   GetVideoMode; 
  1372.   IF BaseOfScreen = $B000 Then Begin 
  1373.         Fore := White; 
  1374.         Back := Black; 
  1375.      End 
  1376.   Else Begin 
  1377.         Fore := Blue; { make these whatever you want } 
  1378.         Back := Black; 
  1379.      End; 
  1380.   NormVideo; 
  1381.   TextColor( Fore ); 
  1382.   TextBackGround( Back ); 
  1383.   ClrScr; 
  1384. End. 
  1385.